Power Programmierung/Power-Programmierung (Tewi)(1994).iso/max/max130/animal.max

Text File | 1988-10-30 | 5KB | 203 lines

; This program is based (loosely) on a program
; that was available on Dartmouth Time Sharing.

tclear ()

$replace ("TRUE"        "1")
$replace ("FALSE"       "0")
$replace ("ANIMAL_FILE" "animal.lst")

put ("loading animal()")

Function animal
    Begin
        print_usage ()
        set (ld restore_knowledge ())
        While
            more_questions (ld)
        EndWhile
        save_knowledge (ld)
    End
EndFunction

put ("loading more_questions()")

Function more_questions
    Begin
        set (ld argv (1))
        ask_question (ld)
        If get_response ()
            Then
                return (process_yes_response (ld))
            EndThen
            Else
                return (process_no_response (ld))
            EndElse
        EndIf
    End
EndFunction

put ("loading ask_question()")

Function ask_question
    Begin
        set (ld argv (1))
        set (question lstcget (ld))
        If ne (strsub (question strlen (question)) "?")
            Then
                put (question "?")
            EndThen
            Else
                put (question)
            EndElse
        EndIf
    End
EndFunction

put ("loading get_response()")

Function get_response
    Begin
        Loop
            get (response)
            set (response struc (strsub (response 1 1)))
            Case response
                When "Y"
                    Do
                        return (TRUE)
                    EndDo
                EndWhen
                When "N"
                    Do
                        return (FALSE)
                    EndDo
                EndWhen
                Default
                    Do
                        put ("Please answer yes or no.")
                    EndDo
                EndDefault
            EndCase
        EndLoop
    End
EndFunction

put ("loading process_yes_response()")

Function process_yes_response
    Begin
        set (ld argv (1))
        If lstnval (ld)
            Then
                lstnext (ld)
                return (TRUE)
            EndThen
            Else
                put ("I guessed it.")
                return (FALSE)
            EndElse
        EndIf
    End
EndFunction

put ("loading process_no_response()")

Function process_no_response
    Begin
        set (ld argv (1))
        If lstsval (ld)
            Then
                lstsub (ld)
                return (TRUE)
            EndThen
            Else
                get_new_question (ld)
                return (FALSE)
            EndElse
        EndIf
    End
EndFunction

put ("loading get_new_question()")

Function get_new_question
    Begin
        set (ld argv (1))
        put ("I give up.")
        put ("What animal did you have in mind?")
        get (animal_name)
        put ("Enter a question that has a yes answer for")
        put ("   " animal_name)
        put ("and distinguishes it from other animals.")
        get (animal_question)
        lstspsh (ld animal_question)
        set (animal_question format ("Is it a %s?", animal_name))
        lstcpsh (ld animal_name)
    End
EndFunction

put ("loading restore_knowledge()")

Function restore_knowledge
    Begin
        set (fd open (ANIMAL_FILE "r"))
        If lt (fd 0)
            Then
                set (ld initialize_list ())
            EndThen
            Else
                set (ld lstread (fd))
            EndElse
        EndIf
        close (fd)
        lsthead (ld)
        return (ld)
    End
EndFunction

put ("loading save_knowledge()")

Function save_knowledge
    Begin
        set (ld argv (1))
        set (fd open (ANIMAL_FILE "wc"))
        If lt (fd 0)
            Then
                put ("Cannot open " ANIMAL_FILE " for writing.")
            EndThen
            Else
                lstwrite (ld fd)
                close (fd)
            EndElse
        EndIf
        lstfre (ld)
    End
EndFunction

put ("loading initialize_list()")

Function initialize_list
    Begin
        set (ld lstcre ("Does it have wings?" "Is it a bird?"))
        return (ld)
    End
EndFunction

put ("loading print_usage()")

Function print_usage
    Begin
        put ("Think of an animal. I will ask simple yes or no")
        put ("questions and try to guess it. If I can't guess it")
        put ("then I will give up and ask you what your animal was")
        put ("and what distinguishes it from other animals. I will")
        put ("remember that information and use it next time.")
        put ("\nWould you like to continue?")
        If not (get_response ())
            Then
                exit ()
            EndThen
        EndIf
    End
EndFunction